home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / CMPLTPAS / HEXDUMP.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-13  |  5KB  |  155 lines
  1. {--------------------------------------------------------------}
  2. {                          HexDump                             }
  3. {                                                              }
  4. {            Hex dump program for all disk files               }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V5.0                }
  8. {                             Last update 7/14/88              }
  9. {                                                              }
  10. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  11. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  12. {--------------------------------------------------------------}
  13.  
  14. PROGRAM HexDump;
  15.  
  16. {$V-}  { Relaxes String length type checking on VAR paramaters }
  17.  
  18. CONST
  19.   Up   = True;
  20.   Down = False;
  21.  
  22. TYPE
  23.   String255   = String[255];
  24.   String128   = String[128];
  25.   String80    = String[80];
  26.   String40    = String[40];
  27.   Block       = ARRAY[0..127] OF Byte;  { One disk sector   }
  28.   BlockArray  = ARRAY[0..15] OF Block;  { BlockRead reads   }
  29.                                         { 16 Blocks at once }
  30.  
  31.  
  32. VAR
  33.   I,J,K       : Integer;
  34.   Parm        : String80;
  35.   Ch          : Char;
  36.   DumpFile    : FILE;
  37.   XBlock      : Block;
  38.   DiskData    : BlockArray;
  39.   Blocks      : Integer;        { Counts Blocks within }
  40.                                 { BlockArray }
  41.   BlockCount  : Integer;        { Tallies total # Blocks Read }
  42.   Buffers     : Integer;
  43.   Remains     : Integer;
  44.   Device      : Text;           { Will be either LST: or CON: }
  45.   BytesRead   : Integer;
  46.  
  47.  
  48. {$I FRCECASE.SRC }   { Described in Section 15.3 }
  49. {$I YES.SRC }        { Described in Section 18.3 }
  50. {$I WRITEHEX.SRC }   { Described in Section 23.5 }
  51.  
  52.  
  53. {>>>>DumpBlock<<<<}
  54.  
  55. PROCEDURE DumpBlock(XBlock : Block; VAR Device : Text);
  56.  
  57. VAR
  58.   I,J,K : Integer;
  59.   Ch    : Char;
  60.  
  61. BEGIN
  62.   FOR I:=0 TO 7 DO        { Do a hexdump of 8 lines of 16 chars }
  63.     BEGIN
  64.       FOR J:=0 TO 15 DO   { Show hex values }
  65.         BEGIN
  66.           WriteHex(Device,Ord(XBlock[(I*16)+J]));
  67.           Write(Device,' ')
  68.         END;
  69.       Write(Device,'   |');    { Bar to separate hex & ASCII }
  70.       FOR J:=0 TO 15 DO        { Show printable chars or '.' }
  71.         BEGIN
  72.           Ch:=Chr(XBlock[(I*16)+J]);
  73.           IF ((Ord(Ch)<127) AND (Ord(Ch)>31))
  74.           THEN Write(Device,Ch) ELSE Write(Device,'.')
  75.         END;
  76.       Writeln(Device,'|')
  77.     END;
  78.   FOR I:=0 TO 1 DO Writeln(Device,'')
  79. END;  { DumpBlock }
  80.  
  81.  
  82. {<<<<ShowHelp>>>>}
  83.  
  84. PROCEDURE ShowHelp(HelpName : String80);
  85.  
  86. VAR
  87.   HelpFile : Text;
  88.   HelpLine : String80;
  89.   I        : Integer;
  90.  
  91. BEGIN
  92.   Writeln;
  93.   Assign(HelpFile,HelpName);
  94.   {$I-} Reset(HelpFile); {$I+}
  95.   IF IOResult = 0 THEN
  96.     FOR I := 1 TO 24 DO
  97.       BEGIN
  98.         Readln(HelpFile,HelpLine);
  99.         Writeln(HelpLine)
  100.       END;
  101.   Close(HelpFile)
  102. END;
  103.  
  104.  
  105. BEGIN
  106.   Parm := '';
  107.                                  { Caps lock printer parameter }
  108.   IF ParamCount > 1 THEN Parm := ForceCase(Up,ParamStr(2));
  109.   IF ParamCount < 1 THEN         { Error - no parms given }
  110.     BEGIN
  111.       Writeln('<<Error!>> You must enter a filename after invoking');
  112.       Write  ('           HexDump.COM.  Display help screen? (Y/N): ');
  113.       IF Yes THEN ShowHelp('DUMPHELP.TXT')
  114.     END
  115.   ELSE
  116.     BEGIN
  117.       Assign(DumpFile,ParamStr(1));  { Attempt to open the file }
  118.       {$I-} Reset(DumpFile); {$I+}
  119.       IF IOResult <> 0 THEN       { Error if file won't open }
  120.         BEGIN
  121.           Writeln('<<Error!>> File ',ParamStr(1),' does not exist.');
  122.           Write  ('           Display help screen? (Y/N): ');
  123.           IF Yes THEN ShowHelp('DUMPHELP.TXT');
  124.         END
  125.       ELSE
  126.         BEGIN                     { See if print Parm was entered; }
  127.                                   { and select output Device }
  128.           IF (Pos('PRINT',Parm) = 1) OR (Pos('P',Parm) = 1) THEN
  129.             Assign(Device,'PRN') ELSE Assign(Device,'CON');
  130.           Rewrite(Device);
  131.           BlockCount := FileSize(DumpFile) + 1; { FileSize in 128-Byte Blocks }
  132.           IF BlockCount = 0 THEN
  133.             Writeln('File ',ParamStr(1),' is empty.')
  134.           ELSE
  135.             BEGIN
  136.               Buffers := BlockCount DIV 16;  { # of 16-Block Buffers }
  137.               Remains := BlockCount MOD 16;  { # of Blocks in last buffer }
  138.               FOR I := 1 TO Buffers DO       { Dump full 16-Block Buffers }
  139.                 BEGIN
  140.                   BlockRead(DumpFile,DiskData,16,BytesRead); { Read 16 disk Blocks }
  141.                   FOR J := 0 TO 15 DO
  142.                     DumpBlock(DiskData[J],Device)  { Dump 'em... }
  143.                 END;
  144.               IF Remains > 0 THEN  { If fractional buffer Remains, dump it }
  145.                 BEGIN
  146.                   BlockRead(DumpFile,DiskData,Remains,BytesRead); { Read last buffer }
  147.                   FOR I := 0 TO Remains-1 DO
  148.                     DumpBlock(DiskData[I],Device)       { Dump it }
  149.                 END
  150.             END;
  151.           Close(DumpFile)
  152.         END
  153.     END
  154. END.
  155.